home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE15 / IDAPI / Bdecmpnt / tjtable2.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-09-12  |  12.9 KB  |  457 lines

  1. { TjocTable2 - implements additional BDE functional for TjocTable
  2.   This is the new improved version with even more added features
  3.  
  4.   Copyright John O'Connell 1996
  5.   All rights reserved
  6. }
  7.  
  8. unit Tjtable2;
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes;
  15.  
  16. type
  17.   TPassWdPriv  = (prNone,prReadOnly,prModify,prInsert,prInsDel,prFull,prUnknown);
  18.   TPasswdPrivs = set of TPassWdPriv;
  19.   TDbiNameStr  = string;
  20.   TRecNoCap    = (rnRecordNum, rnSequenceNum, rnUnsupported);
  21.  
  22.   TjocTable2 = class(TTable)
  23.   private
  24.     { Private declarations }
  25.     FTblType: TDbiNameStr;
  26.     FDeleted: Boolean;     {is the record "soft" deleted}
  27.     FRecNoCap: TRecNoCap;  {sequence or record numbering supported}
  28.     FBMStable: Boolean;    {stable bookmarks?}
  29.     FSoftDelCap: Boolean;  {supports "soft" record deletion}
  30.     FRecordNumber: LongInt;
  31.     FShowDeleted: Boolean;
  32.     FBlockSize: Word;      {table block size}
  33.     FTableLevel: Word;     {table structure version}
  34.     FProtected: Boolean;   {is the table password protected?}
  35.     FPasswords: Word;      {number of auxiliary passwords}
  36.     FTableRights: TPasswdPrivs;
  37.     FRestructVer: Word;    {number of times restructured}
  38.     function GetDeleted: Boolean;
  39. {$IFNDEF Win32}
  40.     function GetRecordNumber: LongInt;
  41. {$ENDIF}
  42.     procedure InitTableProperties(const Cursor: HDBICur);
  43.     procedure SetShowDeleted(const Value: Boolean);
  44.     procedure BoolProp(const Value: Boolean);
  45.     procedure WordProp(const Value: Word);
  46.     procedure PasswdProp(const Value: TPasswdPrivs);
  47.     procedure PackPdoxTable;
  48.     function ChkRecLock: Boolean;
  49.     function ChkShared: Boolean;
  50.     function GetOpenCursors: Word;
  51.   protected
  52.     { Protected declarations }
  53.     function CreateHandle: HDBICur; override;
  54.     procedure CheckActiveExclusive;
  55.     procedure CheckRemote;
  56.   public
  57.     { Public declarations }
  58.     property Deleted: Boolean read GetDeleted;
  59. {$IFNDEF Win32}
  60.     property RecNo: LongInt read GetRecordNumber;
  61. {$ENDIF}
  62.     property StableBookMarks: Boolean read FBMStable;
  63.     property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted default False;
  64.     property IsRecordLocked: Boolean read ChkRecLock;
  65.     property IsShared: Boolean read ChkShared;
  66.     property OpenCount: Word read GetOpenCursors;
  67.     constructor Create(AOwner: TComponent); override;
  68.     destructor Destroy; override;
  69.     procedure UndeleteRecord;
  70.     procedure GotoRecord(const RecNo: LongInt);
  71.     procedure MoveRelative(const Delta: LongInt);
  72.     function CountTableLocks(const LockType: DBILockType): Word;
  73.     procedure LockRecord(const LockType: DBILockType);
  74.     procedure UnlockRecord(const All: Boolean);
  75.     procedure Flush;
  76.     procedure Pack;
  77. {$IFNDEF Win32}
  78.     procedure RenameTable(const RenameTo: string);
  79. {$ENDIF}
  80.     procedure CopyTable(const Destination: string);
  81.     procedure RebuildIndexes;
  82.     procedure RebuildIndex(const Idx: word);
  83.     procedure RebuildNamedIndex(const IdxName: TDbiNameStr);
  84.   published
  85.     { Published declarations }
  86.     property BlockSize: Word read FBlockSize write WordProp;
  87.     property TableLevel: Word read FTableLevel write WordProp;
  88.     property IsProtected: Boolean read FProtected write BoolProp;
  89.     property PasswordCount: Word read FPasswords write WordProp;
  90.     property RestructVersion: Word read FRestructVer write WordProp;
  91.     property TableRights: TPasswdPrivs read FTableRights write PasswdProp;
  92.   end;
  93.  
  94.  
  95. function TransActive(ADatabase: TDatabase): Boolean;
  96. procedure Register;
  97.  
  98. implementation
  99.  
  100. uses DBConsts;
  101.  
  102. function TransActive(ADatabase: TDatabase): Boolean;
  103. var XAct: XInfo;
  104. begin
  105.   Result := False;
  106.   Check(DbiGetTranInfo(ADatabase.Handle, nil, @XAct));
  107.   Result := (XAct.exState = xsActive);
  108. end;
  109.  
  110. constructor TjocTable2.Create(AOwner: TComponent);
  111. begin
  112.   inherited Create(AOwner);
  113.   FShowDeleted := False;
  114. end;
  115.  
  116. destructor TjocTable2.Destroy;
  117. begin
  118.   inherited Destroy;
  119. end;
  120.  
  121. procedure TjocTable2.BoolProp(const Value: Boolean);
  122. begin
  123. end;
  124.  
  125. procedure TjocTable2.WordProp(const Value: Word);
  126. begin
  127. end;
  128.  
  129. procedure TjocTable2.PasswdProp(const Value: TPasswdPrivs);
  130. begin
  131. end;
  132.  
  133. function TjocTable2.ChkRecLock: Boolean;
  134. var WBool: Bool;
  135. begin
  136.   Result := False;
  137.   if State = dsInactive then DBError(SDataSetClosed);
  138.   if State in [dsBrowse, dsEdit] then
  139.   begin
  140.     UpdateCursorPos;
  141.     Check(DbiIsRecordLocked(Handle, WBool));
  142.     Result := Boolean(WBool);
  143.   end;
  144. end;
  145.  
  146. function TjocTable2.CountTableLocks(const LockType: DBILockType): Word;
  147. begin
  148.   Result := 0;
  149.   if State = dsInactive then DBError(SDataSetClosed);
  150.   Check(DbiIsTableLocked(Handle, LockType, Result));
  151. end;
  152.  
  153. function TjocTable2.ChkShared: Boolean;
  154. var WBool: Bool;
  155. begin
  156.   Result := False;
  157.   if State = dsInactive then DBError(SDataSetClosed);
  158.   Check(DbiIsTableShared(Handle, WBool));
  159.   Result := Boolean(WBool);
  160. end;
  161.  
  162. function TjocTable2.GetOpenCursors: Word;
  163. var szTabName:           DBITBLNAME;
  164.     szDBName, szTabType: DBINAME;
  165.     TempDb:              HDbiDb;
  166.     RetCode:             DBIResult;
  167.     DBDescr:             DBDesc;
  168. begin
  169.   Result := 0;
  170.   AnsiToNative(DBLocale, DatabaseName, szDBName, sizeof(szDBName) - 1);
  171.   AnsiToNative(DBLocale, TableName, szTabName, sizeof(szTabName) - 1);
  172.   AnsiToNative(DBLocale, FTblType, szTabType, sizeof(szTabType) - 1);
  173.   {because DbiOpenTableCount can be called even if the table isn't open we
  174.    must open a temporary database for the purpose of calling that function}
  175.   Check(DbiGetDatabaseDesc(szDBName, @DBDescr));
  176.   Check(DbiOpenDatabase(szDBName, DBDescr.szDBType, dbiREADONLY, dbiOPENSHARED,
  177.                                 nil, 0, nil, nil, TempDB));
  178.   RetCode := DbiGetTableOpenCount(TempDB, szTabName, szTabType, Result);
  179.   DbiCloseDatabase(TempDB);
  180.   Check(RetCode);
  181. end;
  182.  
  183. procedure TjocTable2.LockRecord(const LockType: DBILockType);
  184. begin
  185.   if State <> dsBrowse then
  186.     DatabaseError('Cannot lock record in current dataset state');
  187.   UpdateCursorPos;
  188.   Check(DbiGetRecord(Handle, LockType, nil, nil));
  189. end;
  190.  
  191. procedure TjocTable2.UnlockRecord(const All: Boolean);
  192. begin
  193.   if State <> dsBrowse then
  194.     DatabaseError('Cannot unlock record in current dataset state');
  195.   UpdateCursorPos;
  196.   Check(DbiRelRecordLock(Handle, All));
  197. end;
  198.  
  199. procedure TjocTable2.InitTableProperties(const Cursor: HDBICur);
  200. const PrivRights : array[TPasswdPriv] of Word =
  201.                     (prvNONE, prvREADONLY, prvMODIFY, prvINSERT,
  202.                      prvINSDEL, prvFULL, prvUNKNOWN);
  203. var Props: CURProps;
  204.     i:     TPasswdPriv;
  205. begin
  206.   Check(DbiGetCursorProps(Cursor, Props));
  207.   case Props.iSeqNums of
  208.     0: FRecNoCap := rnRecordNum;
  209.     1: FRecNoCap := rnSequenceNum;
  210.   else FRecNoCap := rnUnSupported;
  211.   end;
  212.  
  213.   FSoftDelCap := Props.bSoftDeletes;
  214.   FBMStable   := Props.bBookMarkStable;
  215.   FBlockSize  := Props.iBlockSize;
  216.   FTableLevel := Props.iTblLevel;
  217.   FProtected  := Props.bProtected;
  218.   FPasswords  := Props.iPasswords;
  219.   FRestructVer:= Props.iRestrVersion;
  220.  
  221.   FTableRights := [];
  222.   for i := prNone to prUnknown do
  223.     if (Props.eprvRights and PrivRights[i]) = PrivRights[i] then
  224.       Include(FTableRights, i);
  225.   NativeToAnsi(DBLocale, Props.szTableType, FTblType);
  226. end;
  227.  
  228. procedure TjocTable2.SetShowDeleted(const Value: Boolean);
  229. begin
  230.   if State = dsInactive then DBError(SDataSetClosed);
  231.   if (Value <> FShowDeleted) then
  232.   begin
  233.     if FSoftDelCap then
  234.     begin
  235.       Check(DbiSetProp(HDBIObj(Handle), curSOFTDELETEON, LongInt(Value)));
  236.       FShowDeleted := Value;
  237.     end
  238.     else
  239.       FShowDeleted := False;
  240.   end;
  241. end;
  242.  
  243. function TjocTable2.CreateHandle: HDBICur;
  244. begin
  245.   Result := inherited CreateHandle;
  246.   InitTableProperties(Result);   {initialise table capabilities flags}
  247. end;
  248.  
  249. procedure TjocTable2.CheckActiveExclusive;
  250. begin
  251.   if not(Active and Exclusive) then
  252.     DatabaseError('Table must be opened for exclusive use');
  253. end;
  254.  
  255. procedure TjocTable2.CheckRemote;
  256. begin
  257.   if Active and Database.IsSQLBased then
  258.     DatabaseError('Operation not applicable for remote datasource');
  259. end;
  260.  
  261. function TjocTable2.GetDeleted: Boolean;
  262. var Props: RECProps;
  263. begin
  264.   Result := False;
  265.   if State = dsInactive then DBError(SDataSetClosed);
  266.  
  267.   if FSoftDelCap then
  268.   try
  269.     UpdateCursorPos;
  270.     Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
  271.     Result := Props.bDeleteFlag;
  272.   except
  273.     Result := False;
  274.   end;
  275. end;
  276.  
  277. {$IFNDEF Win32}
  278. function TjocTable2.GetRecordNumber: LongInt;
  279. var Props: RECProps;
  280. begin
  281.   Result := -1;
  282.   UpdateCursorPos;
  283.   Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
  284.   case FRecNoCap of
  285.     rnSequenceNum: Result := Props.iSeqNum;
  286.     rnRecordNum:   Result := Props.iPhyRecNum;
  287.   end;
  288. end;
  289. {$ENDIF}
  290.  
  291. procedure TjocTable2.UndeleteRecord;
  292. var Props: RECProps;
  293. begin
  294.   if State = dsInactive then DBError(SDataSetClosed);
  295.   if FSoftDelCap then
  296.   begin
  297.     UpdateCursorPos;
  298.     Check(DbiUndeleteRecord(Handle));
  299.   end;
  300. end;
  301.  
  302. procedure TjocTable2.GotoRecord(const RecNo: LongInt);
  303. begin
  304.   if State = dsInactive then DBError(SDataSetClosed);
  305.   UpdateCursorPos;
  306.   case FRecNoCap of
  307.     rnSequenceNum: Check(DbiSetToSeqNo(Handle, RecNo));
  308.     rnRecordNum:   Check(DbiSetToRecordNo(Handle, RecNo));
  309.   end;
  310.   Refresh;
  311. end;
  312.  
  313. procedure TjocTable2.MoveRelative(const Delta: LongInt);
  314. begin
  315.   if State = dsInactive then DBError(SDataSetClosed);
  316.   UpdateCursorPos;
  317.   Check(DbiGetRelativeRecord(Handle, Delta, dbiNOLOCK, nil, nil));
  318.   Refresh;
  319. end;
  320.  
  321. procedure TjocTable2.Flush;
  322. begin
  323.   if State = dsBrowse then
  324.     Check(DbiSaveChanges(Handle));
  325. end;
  326.  
  327. procedure TjocTable2.Pack;
  328. var SaveActive, SaveExcl: Boolean;
  329. begin
  330.   SaveActive := Active;
  331.   SaveExcl   := Exclusive;
  332.   try
  333.     Close;
  334.     Exclusive := True;
  335.     Open;
  336.     if CompareStr(FTblType, StrPas(szPARADOX)) = 0 then
  337.       PackPdoxTable
  338.     else
  339.       if CompareStr(FTblType, StrPas(szDBASE)) = 0 then
  340.         Check(DbiPackTable(Database.Handle, Handle, nil, nil, True))
  341.       else
  342.         DatabaseError(format('Cannot pack this table type (%s)', [FTblType]));
  343.   finally
  344.     Close;
  345.     Exclusive := SaveExcl;
  346.     Active    := SaveActive;
  347.   end;
  348. end;
  349.  
  350. procedure TjocTable2.PackPdoxTable;
  351. var TblDesc: CRTblDesc;
  352.     hDB:  HDbiDb;
  353.     RetCode: DBIResult;
  354. begin
  355.   FillChar(TblDesc, sizeof(TblDesc), 0);
  356.   AnsiToNative(DBLocale, TableName, TblDesc.szTblName, sizeof(TblDesc.szTblName)-1);
  357.   AnsiToNative(DBLocale, FTblType, TblDesc.szTblType, sizeof(TblDesc.szTblType)-1 );
  358.   TblDesc.bPack := True;
  359.  
  360.   hDB := Database.Handle;
  361.   Close;
  362.   Check(DbiDoRestructure(hDB, 1, @TblDesc, nil, nil, nil, False));
  363. end;
  364.  
  365. {$IFNDEF Win32}
  366. procedure TjocTable2.RenameTable(const RenameTo: string);
  367. var hDB: HDbiDb;
  368.     szRenFrom, szRenTo: DBITBLNAME;
  369.     RetCode: DBIResult;
  370.     SaveActive, SaveExcl: Boolean;
  371. begin
  372.   SaveActive := Active;
  373.   SaveExcl   := Exclusive;
  374.   try
  375.     Close;
  376.     Exclusive := True;
  377.     Open;
  378.     hDB := Database.Handle;
  379.     Close;
  380.     AnsiToNative(DBLocale, RenameTo, szRenTo, sizeof(szRenTo)-1);
  381.     AnsiToNative(DBLocale, TableName, szRenFrom, sizeof(szRenFrom)-1);
  382.     Check(DbiRenameTable(hDB, szRenFrom, nil, szRenTo));
  383.   finally
  384.     Close;
  385.     TableName := RenameTo;
  386.     Exclusive := SaveExcl;
  387.     Active    := SaveActive;
  388.   end;
  389. end;
  390. {$ENDIF}
  391.  
  392. procedure TjocTable2.CopyTable(const Destination: string);
  393. var szCopyFrom, szCopyTo: DBITBLNAME;
  394. begin
  395.   if State = dsInactive then DBError(SDataSetClosed);
  396.   try
  397.     LockTable(ltReadLock);
  398.     AnsiToNative(Locale, Destination, szCopyTo, sizeof(szCopyTo)-1);
  399.     AnsiToNative(Locale, TableName, szCopyFrom, sizeof(szCopyFrom)-1);
  400.     Check(DbiCopyTable(Database.Handle, True, szCopyFrom, nil, szCopyTo));
  401.   finally
  402.     UnLockTable(ltReadLock);
  403.   end;
  404. end;
  405.  
  406. procedure TjocTable2.RebuildIndexes;
  407. begin
  408.   CheckRemote;
  409.   CheckActiveExclusive;
  410.   Check(DbiRegenIndexes(Handle));
  411. end;
  412.  
  413. procedure TjocTable2.RebuildIndex(const Idx: word);
  414. var IDesc: IDXDesc;
  415. begin
  416.   CheckRemote;
  417.   if (Idx <= 0) then
  418.     DatabaseError('Invalid index sequence number');
  419.   CheckActiveExclusive;
  420.   IndexDefs.Update;
  421.  
  422.   if (Idx <= IndexDefs.Count) then
  423.   begin
  424.     Check(DbiGetIndexDesc(Handle, Idx, IDesc));
  425.     Check(DbiRegenIndex(Database.Handle, Handle, nil,
  426.             nil, IDesc.szName, IDesc.szTagName, IDesc.iIndexID));
  427.   end else
  428.     DataBaseError('Index not found');
  429. end;
  430.  
  431. procedure TjocTable2.RebuildNamedIndex(const IdxName: TDbiNameStr);
  432. var IDesc: IDXDesc;
  433.     Idx:   Integer;
  434.     wIdx:  Word;
  435. begin
  436.   CheckRemote;
  437.   CheckActiveExclusive;
  438.   IndexDefs.Update;
  439.   Idx := IndexDefs.IndexOf(IdxName);
  440.  
  441.   if (Idx >= 0) then
  442.   begin
  443.     wIdx := Succ(Idx);
  444.     Check(DbiGetIndexDesc(Handle, wIdx, IDesc));
  445.     Check(DbiRegenIndex(Database.Handle, Handle, nil,
  446.             nil, IDesc.szName, IDesc.szTagName, IDesc.iIndexId));
  447.   end else
  448.     DatabaseError('Index not found');
  449. end;
  450.  
  451. procedure Register;
  452. begin
  453.   RegisterComponents('JOC', [TjocTable2]);
  454. end;
  455.  
  456. end.
  457.